#!/usr/bin/env perl
###############################################################################
#
# NetCTL client
# Send and retrieve works to a NetCTL 1.2 Server web interface 
# NetCTL server predicts CTL epitopes in protein sequences
# Developed by Marcos Oviedo [marcos.oviedo@fudepan.org.ar]
#
###############################################################################
#
# FuDePAN
# Copyright (C) Marcos Oviedo, 2008 - 2009, FuDePAN
#
#   netctlc is part of hla-hiv-analyzer.
#
#   hla-hiv-analyzer is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#
#   hla-hiv-analyzer is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with hla-hiv-analyzer.  If not, see <http://www.gnu.org/licenses/>.
#
###############################################################################

use strict;
use warnings;
require 5;

# Needed Modules
use Getopt::Long;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request::Common;


# unbuffer the outputs
select STDERR; $| = 1;
select STDOUT; $| = 1;


# some definitions
use constant ZFALSE => 0;
use constant ZTRUE => 1;
use constant ZERROR => 2;
use constant ZOK => 3;
use constant MIN_FILENAME_LENGTH => 8;
use constant NORMAL_FILENAME_LENGTH => 10;
my $defaultNetctlURL = "http://www.cbs.dtu.dk";
my $mainPage = "services/NetCTL";
my $webInterface = "cgi-bin/webface";
my $fudepanUserAgent = "FudepanUserAgent/1.0";


# working variables
my %options;
my $callerScriptName;
my $fastaFileName;
my $superType;
my $cWeight;
my $tapWeight;
my $idThreshold;
my $sortType;
my $detailedMode;
my $helpMode;
my $getSupertypesMode;
my $getSorttypesMode;
my $netCTLUrl;
my $jobID;
my %allowedSuperTypes;
my %allowedSortTypes;
my $errorLine;
my $minutesToWait;
my $tmpFile;
our $verbose;
our $lineMode;

#Grabbing out the caller script name
$callerScriptName = $0;



###############################################################################
# Parsing the arguments provided
#

#Check that enough arguments were provided
if ( @ARGV > 0 )
{
	#Display help if one of the needed arguments are missing
	GetOptions(
	    'get-supertypes'    => \$getSupertypesMode,
	    'print-sort-types'    => \$getSorttypesMode,
	    'fasta-file=s'     => \$fastaFileName,
	    'line-mode'     => \$lineMode,
		'supertype:s'	=> \$superType,
		'c-weight:s'	=> \$cWeight,
		'tap-weight:s'	=> \$tapWeight,
	    'ident-threshold:s' => \$idThreshold,
	    'request-sort:s' => \$sortType,
	    'detailed-results' => \$detailedMode,
	    'netctl-url:s' => \$netCTLUrl,
		'max-minutes:s' => \$minutesToWait,
	    'verbose' => \$verbose,
	    'help|?' => \$helpMode,
	    ) or usage($callerScriptName, "Invalid Arguments were provided");
}
else
{
	usage($callerScriptName, "No arguments were provided");
}



#Help menu was called
if( defined ($helpMode) )
{
	usage($callerScriptName); 
}


#Required arguments were not provided
if( (not defined($fastaFileName) or not defined($superType)) 
	 and not defined($getSupertypesMode) 
	 and not defined($getSorttypesMode) 
  )
{
	usage($callerScriptName, "Required arguments were not provided"); 
}


#GetSuperTypesMode should be used alone
if( defined ($getSupertypesMode) and  
    ( defined($fastaFileName) or  defined($superType) or
 	  defined($cWeight) or defined($tapWeight) or
 	  defined($idThreshold) or defined($sortType) or
 	  defined($netCTLUrl) or defined($getSorttypesMode) or defined($minutesToWait) 
    )
  )
{
	usage($callerScriptName, "get-supertypes should be used without any other option"); 
}

#GetSortTypesMode should be used alone
if( defined ($getSorttypesMode) and  
    ( defined($fastaFileName) or  defined($superType) or
 	  defined($cWeight) or defined($tapWeight) or
 	  defined($idThreshold) or defined($sortType) or
 	  defined($netCTLUrl) or defined($getSupertypesMode) or defined($minutesToWait)
    )
  )
{
	usage($callerScriptName, "print-sorttypes should be used without any other option"); 
}




##############################################################################
# Assigning default values and formmating some of them
#

fudepan_print("Assigning default values\n");
$cWeight = "0.15" if not defined $cWeight;
$tapWeight = "0.05" if not defined $tapWeight;
$idThreshold = "0.75" if not defined $idThreshold;
$sortType = "No_sort" if not defined $sortType;
$minutesToWait = 120 if not defined $minutesToWait;
$superType = uc($superType) if defined $superType;





##############################################################################
# Filling hash of allowed super and sort types
#

#Check that the provided filename exists
if ( defined($fastaFileName) )
{
	fudepan_print("Check that the provided filename exists\n");
	unless ( -e $fastaFileName )
	{
			die "Seems to be a problem while accessing the provided filename: $fastaFileName\n".
				"Check that you provide a valid filename\n";
	}
}

#Grabbing out the list of supertypes
if ( defined($superType) or	defined($getSupertypesMode) )
{
	fudepan_print("Getting the list of allowed supertypes\n");
	#Getting Allowed Supertypes
	unless( get_supertypes("$defaultNetctlURL/$mainPage", \%allowedSuperTypes)  )	  
	{
		die "Seems to be a problem while parsing the allowed supertypes\n".
			"Check that you provide a valid URL for NetCTL operation\n";
	}
}

#Grabbing out the list of sorttypes
if ( defined($sortType) or defined($getSorttypesMode) )
{
	fudepan_print("Getting the list of allowed sorttypes\n");
	#Getting Allowed Sort types
	unless( get_sorttypes("$defaultNetctlURL/$mainPage", \%allowedSortTypes)  )	  
	{
		die "Seems to be a problem while parsing the allowed sort types\n".
			"Check that you provide a valid URL for NetCTL operation\n";
	}
}


##############################################################################
# Sanity check over the arguments
#


fudepan_print("Sanity checks over the provided arguments\n");
#is the provided supertype a valid one?
if (defined($superType))
{
	fudepan_print("Checking if the provided supertype exists\n");
	unless( key_exists(\%allowedSuperTypes, $superType) )
	{
		die "Seems to be a problem with the provided supertype: $superType\n".
			"Check that you provide a valid supertype (this is case sensitive) for NetCTL operation\n";
	}
}


#is the provided sorttype a valid one?  Dont check the default one
if (defined($sortType) and $sortType ne "-1")
{
	fudepan_print("Checking if the provided sorttype exists\n");
	unless( key_exists(\%allowedSortTypes, $sortType) )
	{
		die "Seems to be a problem with the provided sorttype: $sortType\n".
			"Check that you provide a valid sorttype (this is case sensitive) for NetCTL operation \n";
	}
}





###############################################################################
# Real work starts here
#


#if getSuperTypes mode was specified, print and exit 
if ( defined($getSupertypesMode) )
{		
	fudepan_print("Printing supertypes allowed\n");
	unless( print_hash_keys(\%allowedSuperTypes) )
	{
		die "Seems to be a problem while printing the supertypes\n".
			"Check that you are not a victim of a zombie apocalypsis\n";
	}

	#exit properly
	exit(0)

}

#if getSorttypesMode mode was specified, print and exit 
if ( defined($getSorttypesMode) )
{		
	fudepan_print("Printing sort types allowed\n");
	unless( print_hash_keys(\%allowedSortTypes) )
	{
		die "Seems to be a problem while printing the sorttypes\n".
			"Check that you are not a victim of a zombie apocalypsis\n";
	}

	#exit properly
	exit(0)
}


#OK, getModes* were not specified, crafting post to NetCTL web interface
fudepan_print("Sending work to NetCTL webface URL\n");
unless( send_work_netctl( 
						  "$defaultNetctlURL/$webInterface",
						  \$jobID,
						  $fastaFileName,
						  $superType,
						  $cWeight,
						  $tapWeight,
						  $idThreshold,
						  $sortType,
						  $fudepanUserAgent, 
						  \$errorLine
						)
	   )
{
	die "Seems to be a problem while sending work: $errorLine\n".
		"Check that you you provide a valid URL and that the web interface is working\n";
}

#JobID obtained
fudepan_print("Got JobID: $jobID\n");

#Forging a temporal filename
#$tmpFile = "/tmp/fudepan_netctlc_". get_random_filename(NORMAL_FILENAME_LENGTH);
$tmpFile = "/tmp/fudepan_netctlc_jobID_". $jobID .".html";

#Touching temporal filename, not checking status for now
touch_filename($tmpFile);

fudepan_print("Using $tmpFile as the storage file\n");

#Waiting for the job to finish
fudepan_print("Waiting ".$minutesToWait." minutes as the maximum delay for the job to finish \n");
unless( wait_for_job("$defaultNetctlURL/$webInterface", $jobID, $minutesToWait, $tmpFile) )
{
	die "Seems to be a problem while waiting for the following job to finish: $jobID\n".
		"Check that a valid file was provided for NetCTL operation\n";
}


#Getting job results
fudepan_print("Getting Job results\n");
unless( get_job_results("$defaultNetctlURL/$webInterface", $jobID, $minutesToWait, $tmpFile) )
{
	die "Seems to be a problem while getting the results of job: $jobID\n".
		"Check that a valid file was provided for NetCTL operation\n";
}


#Printing the results
fudepan_print("Printing Job results\n");
unless( print_job_results($lineMode, $tmpFile) )
{
	die "Seems to be a problem while printing the job results for: $jobID\n".
		"Check that a valid operation was made for the job\n";
}

#deleting temporal filename
unlink($tmpFile);

#Success!
fudepan_print("CTL epitopes in protein sequences were successfully predicted!\n");



###############################################################################
# Functions
#


#######
# Wrapper print to stdout
# Parameter: input to print
# Returns: nothing	
#
sub fudepan_print
{
    my $string = shift;

	if ( defined($verbose) )
	{
		# flush all output immediately
		$| = 1;	
		print STDERR "[+] $string";
	}
}

#######
# generate random character
# Parameter: nothing
# Returns: temporal char
#
sub get_random_char
{
        my @chars=( "A" .. "Z", "a" .. "z", 0 .. 9);

        return @chars[rand @chars];
}

#######
# generate a temporal filename on /tmp directory
# Parameter: required filename length
# Returns: temporal filename
#
sub get_random_filename
{
    my $length = shift;
    my $filename = "";
	my $cnt;

    for ($cnt = 0; $length > MIN_FILENAME_LENGTH && $cnt < $length; $cnt++)
    {
            $filename .= get_random_char();
    }

    return "$filename";
}

#######
# Rouch a given file
# Parameter: required filename
# Returns: operation status
#
sub touch_filename
{
    my $file = shift;
    my $cmd_to_execute = "";
    my $result = "";
    my $status = "";

    #remove return character
    chomp($file);

	#Forging out the helper CMD
	$cmd_to_execute = "/usr/bin/env touch $file";

	$result = `$cmd_to_execute`;
    $status = $?;

    return $status;
}


#######
# Print usage information
# Parameter: script name
# Returns: nothing
#
sub usage 
{
    my ($caller, $stringToDisplay) = @_;

	if ( defined ($stringToDisplay) )
	{
		print STDERR ("Problem detected: $stringToDisplay\n");	
	} 

	#printing help
	die << "EOF";
Send and retrieve works to a NetCTL 1.2 Server web interface
NetCTL server predicts CTL epitopes in protein sequences
Developed by Marcos Oviedo [marcos.oviedo at fudepan.org.ar]

Usage: $caller [options] (please use quotes for "long inputs")
Required options: --fasta-file		Fasta file to submit for processing 	
       	          --supertype		Supertype to use	
       	          	                                                  
Optional options: --get-supertypes	Print the supertypes available at the NetCTL web interface 
       	          --print-sort-type	Print the sort types available at the NetCTL web interface 
       	          --line-mode		Print one results per-line
       	          --c-weight		Weight on C terminal cleavage (default to 0.15)
       	          --tap-weight		Weight on TAP transport efficiency (default to 0.05)
       	          --ident-threshold	Threshold for epitope identification (default to 0.75)
                  --request-sort	Sort by score (default to none)
                  --detailed-results	Full report of CTL epitopes prediction
                  --netctl-url		URL whet NetCTL web interface is (default to $defaultNetctlURL )
                  --max-minutes		Maximum Number of minutes to wait for a job to finish (default to 120 min )
       	          --verbose		Verbose output
       	          --help		Help Menu
EOF

}


#######
# Check that the provided $value exists on the hash keys space
# Parameter: Ptr to the HASH  and key to look for
# Returns: True or False according the results of the Operation
#
sub key_exists
{
	my ($ptrHash, $keyToLookFor) = @_;
	my $status = ZFALSE;
	my $key;
	my $value;

	#check if the provided value exists
    while ( ($key, $value) = each(%$ptrHash) )
    {
		if ( $keyToLookFor =~ /^$key$/ )
		{ 
			$status = ZTRUE;		
		}
    }

	return $status;	 
}


#######
# Print keys available in a hash
# Parameter: Ptr to hash to print
# Returns: True or False according the results of the Operation
#
sub print_hash_keys
{
	my $ptrHash = shift;
	my $status = ZFALSE;
	my $workingKey;
	my $workingValue;
	my $firstItem = ZTRUE;

	if ( defined ($ptrHash) ) 
	{					
		#Printing the obtained list of keys in CVS or one-per-line format							  
		for $workingKey ( sort keys %$ptrHash )
		{
			if ( not defined $lineMode )
			{
				if ($firstItem)
				{ 
					print "$workingKey";
					$firstItem = ZFALSE;
				}
				else
				{
					print ",$workingKey";
				}	 
			}
			else
			{
		 		print "$workingKey\n";
			}						
		}

		print "\n" if not defined $lineMode;
		
		$status = ZTRUE;
	}

	return $status;

}


#######
# Get the list of allowed supertypes
# Parameter: URL of NetCTL main page and array to store list of supertypes
# Returns: True or False according the results of the Operation
#
sub get_supertypes
{
	my ($urlNetCTL, $ptrHashToStore) = @_;
	my $status = ZFALSE;
	my $htmlPage;
	my $matchedHTML;
	my $item;
	my $keySupertype;
	my $valueSupertype;


	#querying the web interface
	$htmlPage = get($urlNetCTL);

	if ( defined ($htmlPage) )
	{
		#getting list of supertypes items 
		$htmlPage =~ /<select name=supertype>/;
		$' =~ /<\/select>/;
		$matchedHTML = $`;
									
		#splitting the provided results												 
		foreach $item ( split(/\n/,$matchedHTML) )
		{
			#look for option item
			if ( $item =~ /<option value=(.+)>(.+)/ )			
			{			
				$keySupertype = $2;					
				$valueSupertype = $1;

				#stripping out the supertype word from key
				$keySupertype =~ s/\ssupertype//;

				if ( not defined( $ptrHashToStore->{$keySupertype} ) )
				{
					$ptrHashToStore->{$keySupertype} = $valueSupertype;
					$status = ZTRUE;			
				} 
			}
		}
	}
		
	return $status;
}


#######
# Get the list of allowed sorttypes
# Parameter: URL of NetCTL main page and array to store list of sortypes
# Returns: True or False according the results of the Operation
#
sub get_sorttypes
{
	my ($urlNetCTL, $ptrHashToStore) = @_;
	my $status = ZFALSE;
	my $htmlPage;
	my $matchedHTML;
	my $item;
	my $keySorttype;
	my $valueSorttype;


	#querying the web interface
	$htmlPage = get($urlNetCTL);

	if ( defined ($htmlPage) )
	{
		#getting list of supertypes items 
		$htmlPage =~ /<select name=sort>/;
		$' =~ /<\/select>/;
		$matchedHTML = $`;
									
		#splitting the provided results												 
		foreach $item ( split(/\n/,$matchedHTML) )
		{
			#look for option item
			if ( $item =~ /<option value=(.+)>(.+)/ )			
			{			
				$keySorttype = $2;					
				$valueSorttype = $1;

				#Replace withespaces with _
				$keySorttype =~ s/\s/_/;

				if ( not defined( $ptrHashToStore->{$keySorttype} ) )
				{
					$ptrHashToStore->{$keySorttype} = $valueSorttype;
					$status = ZTRUE;			
				} 
			}
		}
	}
		
	return $status;
}



#######
# Post work to the NetCTL web cgi
# Parameter: URL of NetCTL web interface
#			 Ptr to WorkID variable obtained after sending the work
#			 FastaFile to use
#			 Supertype to use
#			 Weight on C terminal cleavage
#			 Weight on TAP transport efficiency 
#			 Threshold for epitope identification
#			 Sort type ID to use
#			 UserAgent to use
# Returns: True or False according the results of the Operation
sub send_work_netctl
{
	my ($urlWebInterface, 
		$workID, 
		$fastaFileName, 
		$superType,
		$cWeight,
		$tapWeight,
		$identThreshold,
		$sortType, 
		$fudepanUserAgent,
		$errorLine
	   ) = @_;

	my $status = ZFALSE;
	my %postInputs;
	my %headerInputs;
	my $browser;
	my $response;


	#filling needed header
	%headerInputs = (
					'Content_Type' => 'form-data',
					'Accept-Language' => 'en-us,en'
				  );


	#filling post inputs
	%postInputs = (
					'configfile' => '/usr/opt/www/pub/CBS/services/NetCTL-1.2/NetCTL.cf',
					'seqpaste' => "",
					'supertype' => $superType,
					'wcle' => $cWeight,
					'wtap' => $tapWeight,
					'threshold' => $identThreshold,
					'sort' => $allowedSortTypes{$sortType},
					'SEQSUB' => [ $fastaFileName ]
				  );

	#Creating browser instance
	$browser = LWP::UserAgent->new();

	#Set User Agent
	$browser->agent($fudepanUserAgent);

	#crafting the POST
	$response = $browser->request( POST $urlWebInterface, 
								   %headerInputs, 
								   Content => \%postInputs
								  );
	
	# Check response
	if ($response->is_success)
	{
	 	#Parsing out jobID
		if ( $response->content =~ /jobid=NetCTL\-1\.2,(.*)&opt/ )
		{ 
			
			$$workID = $1;
			$status = ZTRUE;
		}
	}
	else
	{
		$$errorLine = $response->status_line;
	}

	return $status;	  
}



#######
# Waiting for Job Results
# Parameter: URL of NetCTL webInterface, JobID to use and maximum number of seconds to wait
# Returns: True or False according the results of the Operation
#							   
sub wait_for_job
{
	my ($urlNetCTL, $jobID, $maxMinutesToWait, $storageFile) = @_;
	my $status = ZFALSE;
	my $browser;
	my $response;
	my $queryURL;
	my $line;

	#Forging URL to query
	$queryURL = "$urlNetCTL?jobid=NetCTL-1.2,$jobID&opt=wait";

	while ( $maxMinutesToWait > 0 )
	{
		#Creating browser instance
		$browser = LWP::UserAgent->new();

		#Set User Agent
		$browser->agent($fudepanUserAgent);
		
		#Querying the eface for job results
		$response = $browser->get($queryURL, 
								  ':content_file' => $storageFile);

		#Parsing the results looking for job end
		# Check response
		if ($response->is_success)
		{
			#General log file
			open ( RESPONSE, $storageFile ) or die "can't open $tmpFile, it's pointless to continue.\n";

		 	#Parsing out jobID
			while ($line = <RESPONSE>)
			{

				if ( $line =~ /(The\sjob\shas\sfinished|prediction\sresults)/ )
				{ 
					#Job finally end!
					$maxMinutesToWait = 0;
					$status = ZTRUE;
					last;
				}

				if ( $line =~ /error/i )
				{
					#Problem detected, abort inmediately
					$maxMinutesToWait = 0;
					last;
				}
			}

			close (RESPONSE);
		}
		else
		{
			fudepan_print("Request was not successful. Still having $maxMinutesToWait iterations to try\n");
			$maxMinutesToWait = $maxMinutesToWait - 1;

		}

		if (($status eq ZFALSE) && ($maxMinutesToWait ne 0))
		{		
			fudepan_print("Still waiting for the job to finish. $maxMinutesToWait minutes to go\n");
			#Waiting 1 minute befory making another query attempt
			sleep(60);
			$maxMinutesToWait = $maxMinutesToWait - 1;
		}

	}
	
	return $status;
}



#######
# Waiting for Job Results
# Parameter: URL of NetCTL webInterface, JobID to use and maximum number of seconds to wait
# Returns: True or False according the results of the Operation
#							   
sub get_job_results
{
	my ($urlNetCTL, $jobID, $maxMinutesToWait, $storageFile) = @_;
	my $status = ZFALSE;
	my $browser;
	my $response;
	my $queryURL;
	my $line;

	#Forging URL to query
	$queryURL = "$urlNetCTL?jobid=NetCTL-1.2,$jobID&opt=none";

	while ( $maxMinutesToWait > 0 )
	{
		#Creating browser instance
		$browser = LWP::UserAgent->new();

		#Set User Agent
		$browser->agent($fudepanUserAgent);
		
		#Querying the eface for job results
		$response = $browser->get($queryURL, 
								  ':content_file' => $storageFile);

		# Check response
		if ($response->is_success)
		{
			#Job results was successfully retreived
			$maxMinutesToWait = 0;
			$status = ZTRUE;
		}
		else
		{
			fudepan_print("Request was not successful. Still having $maxMinutesToWait iterations to try\n");
			$maxMinutesToWait = $maxMinutesToWait - 1;

		}

		if (($status eq ZFALSE) && ($maxMinutesToWait ne 0))
		{		
			#Waiting 1 minute befory making another query attempt
			sleep(60);
			$maxMinutesToWait = $maxMinutesToWait - 1;
		}
	}
	
	return $status;
}



#######
# Print job results
# Parameter: Line mode and storage file to use
# Returns: True or False according the results of the Operation
#
sub print_job_results
{
	my ($lineMode, $storageFile) = @_;
	my $status = ZFALSE;
	my $parseStatus = ZOK;
	my $htmlResponse;
	my $queryURL;
	my $matchedHTML;
	my $item;
	my $foundSequenceId;
    my $foundPep;
	my $epitopesIdentified;
	my $epitopesAlreadyFound = 0;
	my $firstResultAlreadyFound = ZFALSE;

	#General log file
	open ( RESPONSE , $storageFile ) or die "can't open $tmpFile, it's pointless to continue.\n";

	#Parsing out response
	while ($item = <RESPONSE>)
	{

		#Checking the beggining of a sequences when we are handling  multiple sequence results
 		if ( $item =~ /\s1\sID\s/ )
		{
			# A new sequence has started, printing a CR 
			if ( $firstResultAlreadyFound eq ZTRUE )
			{
				print "\n";
			}

			# then set proper flags
			$firstResultAlreadyFound = ZFALSE;
		}				
        
		#looking for MHC ligands ocurrences
		if ( ($item =~ /<-E$/) and ($item =~ /(.*)\sID\s(.*)\spep\s(.*)\saff\s(.*)\saff_rescale/) )			
		{
			$foundSequenceId = $1;
            $foundPep = $3;
			$foundSequenceId =~ s/\s+//; 

            if ($firstResultAlreadyFound ne ZTRUE)
			{
				print "($foundSequenceId,$foundPep)";
			}
			else
			{
				print ";($foundSequenceId,$foundPep)";
			}			 					

			$firstResultAlreadyFound = ZTRUE;
			$epitopesAlreadyFound++;
		}


		if ( $item =~ /error/i )
		{
			#Problem detected, abort inmediately
			$parseStatus = ZERROR;
			last;
		}
	}


	close(RESPONSE);

	#Checking if we didn't found any problems while parsing content
	if ( ($epitopesAlreadyFound > 0) and ($parseStatus eq ZOK) )
	{
		$status = ZTRUE;
		print "\n";

	}
	
	return $status;
}









